home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / SHADING.INC < prev    next >
Text File  |  1991-09-25  |  7KB  |  204 lines
  1. {
  2. From:    SKYBLU::ENNS          5-FEB-1988 22:17
  3. To:    LOWEY
  4. Subj:    surf fix
  5.  
  6. This fix performs the shading calculations without converting them to
  7. normalized coordinates first.  This speeds up the shading calculations
  8. but still provide the same results.
  9.  
  10. Provided to Kevin Lowey by Steve Enns of the University of Saskatchewan,
  11.  
  12.    ENNS@SASK.BITNET
  13. }
  14.  
  15. { type vector = array[1..3] of real; }
  16.  
  17. procedure NORMAL (var V: vector);
  18. { normalize the vector V }
  19. var Vmag: real;                { magnitude of the vector }
  20.     J: integer;                { index }
  21. begin
  22.   Vmag := sqrt (sqr (V[1]) + sqr (V[2]) + sqr (V[3]) );
  23.   if (Vmag > 0.0) then
  24.     for J := 1 to 3 do
  25.       V[J] := V[J] / Vmag;
  26. end; { procedure NORMAL }
  27.  
  28. function POWER (X, P: real): real;
  29. { Raise real number X to the power P }
  30. begin
  31.   if (X > 0) then
  32.     if (P > 0) then
  33.       POWER := exp (P * ln(X))
  34.     else if (P = 0) then
  35.       POWER := 1.0
  36.     else
  37.       POWER := 1.0 / exp (-P * ln(X))
  38.   else if (X = 0) then
  39.     POWER := 0.0
  40.   else
  41.     { Forget the negatives; aren't dealing with complex nos. }
  42.     POWER := 0.0;
  43. end; { function POWER }
  44.  
  45. { Common variable for SETSHADE and SHADING }
  46. var S: array[1..MAXLITE] of vector;   { light source vectors }
  47.  
  48. procedure SETSHADE;
  49. { Set up the light source vectors for the shading routine }
  50. var Lite: integer;
  51.  
  52. begin
  53.   for Lite := 1 to Nlite do begin
  54.     S[Lite][1] := Xlite[Lite] - Xfocal;
  55.     S[Lite][2] := Ylite[Lite] - Yfocal;
  56.     S[Lite][3] := Zlite[Lite] - Zfocal;
  57.     normal (S[Lite]);
  58.   end;
  59. end; { procedure SETSHADE }
  60.  
  61. function SHADING (Surf: word; Side: integer): real;
  62. { Calculate the shade of surface Surf at point (X,Y,Z).
  63.   (Returns a negative shade if surface is totally invisible
  64.   [facing away from eye] )
  65.   Side 1 is the primary side of the surface (assumes the nodes are
  66.   numbered counter-clockwise when viewed from the outside of the
  67.   surface). Side 2 is the inside, necessary for viewing surfaces
  68.   that can be seen from either side (such as function plots).
  69. }
  70. var A: vector;                { vector from 1st to 2nd node of surface }
  71.     B: vector;                { vector from 1st to 3rd node of surface }
  72.     N: vector;                { vector normal to surface }
  73.     E: vector;                { vector from 1st node to eye }
  74.     D: vector;                { difference from source to surface normal }
  75.     R: vector;                { vector from 1st node to reflected light }
  76.     J: integer;               { index }
  77.     Node1: word;              { 1st node # }
  78.     Node2: word;              { 2nd node # }
  79.     Node3: word;              { 3rd node # }
  80.     Vmag: real;               { magnitude of vector, reflected lite to eye }
  81.     Cumshade: real;           { cumulative shade (from multiple light sources)}
  82.     Lite: integer;            { light source number }
  83.     CosN: real;               { cosine of angle from light to surface normal }
  84.     CosS: real;               { cosine of angle from reflected light to eye }
  85.  
  86. begin
  87. {$ifdef BIGMEM}
  88. with ptra^ do with ptrb^ do with ptrc^ do with ptri^ do
  89. begin
  90. {$endif}
  91.   if (Side = 1) then begin
  92.     Node1 := Konnec (Surf, 1);
  93.     Node2 := Konnec (Surf, 2);
  94.     Node3 := Konnec (Surf, 3);
  95.   end else begin
  96.     Node1 := Konnec (Surf, 1);
  97.     Node2 := Konnec (Surf, 3);
  98.     Node3 := Konnec (Surf, 2);
  99.   end;
  100.   A[1] := Xworld[Node2] - Xworld[Node1];
  101.   A[2] := Yworld[Node2] - Yworld[Node1];
  102.   A[3] := Zworld[Node2] - Zworld[Node1];
  103.   B[1] := Xworld[Node3] - Xworld[Node1];
  104.   B[2] := Yworld[Node3] - Yworld[Node1];
  105.   B[3] := Zworld[Node3] - Zworld[Node1];
  106.  
  107. { Vector cross product N = A X B }
  108.   N[1] := A[2]*B[3] - A[3]*B[2];
  109.   N[2] := A[3]*B[1] - A[1]*B[3];
  110.   N[3] := A[1]*B[2] - A[2]*B[1];
  111.   normal(N);
  112.  
  113.   E[1] := Xeye - Xworld[Node1];
  114.   E[2] := Yeye - Yworld[Node1];
  115.   E[3] := Zeye - Zworld[Node1];
  116.   normal(E);
  117.  
  118. { Is surface visible to eye? }
  119.   if (E[1]*N[1] + E[2]*N[2] + E[3]*N[3] < 0.0) then
  120.     Shading := -1.0
  121.   else begin
  122.     Cumshade := Ambient[Matl[Surf]];
  123.     for Lite := 1 to Nlite do begin
  124.       for J := 1 to 3 do
  125.         D[J] := S[Lite][J] - N[J];
  126.       { Does surface face away from light source? }
  127.       CosN := S[Lite][1]*N[1] + S[Lite][2]*N[2] + S[Lite][3]*N[3];
  128.       if (CosN < 0.0) then
  129.         { Cumshade := Cumshade + 0.0;} { this light source doesn't contribute}
  130.       else begin
  131.         for J := 1 to 3 do
  132.           R[J] := N[J] - D[J];
  133.         normal(R);
  134.         { Find magnitude of vector from reflected light to eye (divided by 2) }
  135.         Vmag := sqrt (sqr(E[1]-R[1]) + sqr(E[2]-R[2]) + sqr(E[3]-R[3])) / 2.0;
  136.         if (Vmag > 1.0) then
  137.           Vmag := 1.0;
  138.         CosS := 1.0 - sqr(Vmag);
  139.         Cumshade := Cumshade + Intensity[Lite] * (R1[Matl[Surf]] *
  140.                power(CosS, R2[Matl[Surf]]) + R3[Matl[Surf]] * CosN);
  141.       end; { if sqr(D[1]... }
  142.     end; { for Lite }
  143.     Shading := Cumshade;
  144.   end; { if sqr(E[1]... }
  145. {$ifdef BIGMEM}
  146. end; {with}
  147. {$endif}
  148. end; { function SHADING }
  149.  
  150. function VISIBLE (Surf: word; Side: integer): boolean;
  151. { Determine visibility of surface #Surf. If visible, return TRUE.
  152.   If invisible, return FALSE.
  153. }
  154. var A: vector;                { vector from 1st to 2nd node of surface }
  155.     B: vector;                { vector from 1st to 3rd node of surface }
  156.     N: vector;                { vector normal to surface }
  157.     E: vector;                { vector from 1st node to eye }
  158.     Node1: word;              { 1st node # }
  159.     Node2: word;              { 2nd node # }
  160.     Node3: word;              { 3rd node # }
  161.  
  162. begin
  163. {$ifdef BIGMEM}
  164. with ptra^ do with ptrb^ do with ptrc^ do
  165. begin
  166. {$endif}
  167.  
  168.   if (Side = 1) then begin
  169.     Node1 := Konnec (Surf, 1);
  170.     Node2 := Konnec (Surf, 2);
  171.     Node3 := Konnec (Surf, 3);
  172.   end else begin
  173.     Node1 := Konnec (Surf, 3);
  174.     Node2 := Konnec (Surf, 2);
  175.     Node3 := Konnec (Surf, 1);
  176.   end;
  177.   A[1] := Xworld[Node2] - Xworld[Node1];
  178.   A[2] := Yworld[Node2] - Yworld[Node1];
  179.   A[3] := Zworld[Node2] - Zworld[Node1];
  180.   B[1] := Xworld[Node3] - Xworld[Node1];
  181.   B[2] := Yworld[Node3] - Yworld[Node1];
  182.   B[3] := Zworld[Node3] - Zworld[Node1];
  183.  
  184. { Vector cross product N = A X B }
  185.   N[1] := A[2]*B[3] - A[3]*B[2];
  186.   N[2] := A[3]*B[1] - A[1]*B[3];
  187.   N[3] := A[1]*B[2] - A[2]*B[1];
  188. {  normal(N);                             ******* Not required }
  189.  
  190.   E[1] := Xeye - Xworld[Node1];
  191.   E[2] := Yeye - Yworld[Node1];
  192.   E[3] := Zeye - Zworld[Node1];
  193. {  normal(E);                             ******* Not required }
  194.  
  195. { Is surface visible to eye? }
  196.   if (E[1]*N[1] + E[2]*N[2] + E[3]*N[3] < 0.0) then
  197.     Visible := FALSE
  198.   else
  199.     Visible := TRUE;
  200. {$ifdef BIGMEM}
  201. end; {with}
  202. {$endif}
  203. end; { function VISIBLE }
  204.